home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / ARCVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  32KB  |  1,001 lines
  1. UNIT ArcView;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Viser indhold af arkiv, samt bestemmer type   Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos, PoPTypes;
  16.  
  17. FUNCTION  PackerExtension(Num: Byte): S3;
  18. FUNCTION  ArcType(CONST FNam: PathStr): ShortInt;
  19. PROCEDURE ViewArchive(CONST FNam: PathStr; ArcType: ShortInt);
  20.  
  21. IMPLEMENTATION
  22.  
  23. USES OpCrt, OpString, OpWindow, OpKey,
  24.      Globals, StrUtil, OproUtil, Keyboard, Util, Display, Input, FileUtil;
  25.  
  26. CONST
  27.   SelfExtractingOffset : LongInt = 0;
  28.  
  29.   FUNCTION PackerExtension(Num: Byte): S3;
  30.   VAR
  31.     s:S3;
  32.   BEGIN
  33.     CASE Num OF
  34.       0   : s:='???';
  35.       1   : s:='ARC';
  36.       2   : s:='ZIP';
  37.       3   : s:='LZH';
  38.       4   : s:='PAK';
  39.       5   : s:='ZOO';
  40.       6   : s:='SQZ';
  41.       7   : s:='ARJ';
  42.       ELSE  s:='';
  43.     END;
  44.     PackerExtension:=s;
  45.   END;
  46.  
  47.   FUNCTION ArcType(CONST FNam: PathStr): ShortInt;
  48.   TYPE
  49.     ExeHeaderRec = record
  50.       Signature : Word;           {EXE file signature}
  51.       LengthRem : Word;           {Number of bytes in last page of EXE image}
  52.       LengthPages : Word;         {Number of 512 byte pages in EXE image}
  53.       NumReloc : Word;            {Number of relocation items}
  54.       HeaderSize : Word;          {Number of paragraphs in EXE header}
  55.       MinHeap : Word;             {Minimum extra paragraphs to allow}
  56.       MaxHeap : Word;             {Paragraphs to keep beyond end of image}
  57.       StackSeg : Word;            {Initial stack seg relative to image base}
  58.       StackPtr : Word;            {Initial SP}
  59.       CheckSum : Word;            {EXE file check sum, not used}
  60.       IpInit : Word;              {Initial IP}
  61.       CodeSeg : Word;             {Initial code seg relative to image base}
  62.       RelocOfs : Word;            {Bytes into EXE for first relocation item}
  63.       OverlayNum : Word;          {Overlay number, not used here}
  64.     end;
  65.   VAR
  66.     test        : Word;
  67.     f           : FILE;
  68.     buf         : ARRAY[1..10] OF Char;
  69.     x           : ShortInt;
  70.     head        : ExeHeaderRec ABSOLUTE Buf;
  71.   BEGIN
  72.     SelfExtractingOffset:=0;
  73.     x:=0;
  74.     Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
  75.     Reset(f,1);
  76.     test:=IOResult;
  77.     IF test=0 THEN
  78.     BEGIN
  79.       BlockRead(f,buf,10,test);
  80.       IF (buf[1]='H') AND (buf[2]='L') AND (buf[3]='S') AND (buf[4]='Q') AND (buf[5]='Z') THEN x:=6 ELSE
  81.         IF (buf[2]=#234) AND (buf[1]=#96) THEN x:=7 ELSE
  82.           IF (buf[1]='P') AND (buf[2]='K') THEN x:=2 ELSE
  83.             IF (buf[3]='-') AND (buf[4]='l') AND (buf[5]='h') AND (buf[6] IN ['0'..'9']) AND (buf[7]='-') THEN x:=3 ELSE
  84.               IF buf[1]=#26 THEN
  85.               BEGIN
  86.                 { ** CHECK OGSÅ FOR PAK ** }
  87.                 IF buf[2] IN [#1..#9] THEN x:=1 ELSE x:=4;
  88.               END
  89.               ELSE
  90.                 IF (buf[1]='Z') AND (buf[2]='O') AND (buf[3]='O') THEN x:=5 ELSE
  91.                   IF (buf[1]='G') AND (buf[2]='I') AND (buf[3]='F') THEN x:=127;
  92.       IF x=0 THEN               { CHECK SELFEXTRACTING }
  93.       BEGIN
  94.         IF Head.Signature=$5A4D  THEN
  95.         BEGIN
  96.           SelfExtractingOffset:=LongInt(Head.LengthPages-1)*512+LongInt(Head.LengthRem);
  97.           Seek(f,SelfExtractingOffset);
  98.           BlockRead(f,buf,10,test);
  99.           IF (buf[1]='H') AND (buf[2]='L') AND (buf[3]='S') AND (buf[4]='Q') AND (buf[5]='Z') THEN x:=-6 ELSE
  100.             IF ((buf[2]=#234) AND (buf[1]=#96)) OR
  101.                ((buf[4]=#234) AND (buf[3]=#96)) THEN
  102.             BEGIN
  103.               IF buf[4]=#234 THEN Inc(SelfExtractingOffset, 2);
  104.               x:=-7;
  105.             END ELSE
  106.               IF (buf[1]='P') AND (buf[2]='K') AND (buf[3]=#3) AND (buf[4]=#4) THEN x:=-2 ELSE
  107.                 IF (buf[2]='P') AND (buf[3]='K') AND (buf[4]=#3) AND (buf[5]=#4) THEN
  108.                 BEGIN
  109.                   INC(SelfExtractingOffSet);
  110.                   x:=-2;
  111.                 END
  112.                 ELSE
  113.                   IF (buf[1]=#26) THEN
  114.                   BEGIN
  115.                     IF (buf[2] IN [#1..#9]) THEN x:=-1 ELSE x:=-4;
  116.                   END
  117.                   ELSE
  118.                     IF (buf[3]='-') AND (buf[4]='l') AND (buf[5]='h') AND (buf[6] IN ['0'..'9']) AND (buf[7]='-') THEN x:=-3;
  119.         END;
  120.       END;
  121.       Close(f);
  122.     END;
  123.     ArcType:=x;
  124.   END;
  125.  
  126.   PROCEDURE ViewArchive(CONST FNam: PathStr; ArcType: ShortInt);
  127.   TYPE
  128.     TotalArcType = RECORD
  129.       Files          : Word;
  130.       OldSize,
  131.       size           : LongInt;
  132.     END;
  133.     ArcFilePtr = ^ArcFileType;
  134.     ArcFileType = RECORD
  135.       FileName   : S12;
  136.       OldSize,
  137.       NewSize    : LONGINT;
  138.       DT         : DateTime;
  139.       Typ        : S20;
  140.       Mark       : BOOLEAN;
  141.       Next       : ArcFilePtr;
  142.     END;
  143.   VAR
  144.     Error          : BOOLEAN;
  145.     Arc            : ArcFilePtr;
  146.     ArcDT          : DateTime;
  147.     TotalArc       : TotalArcType;
  148.     Wait           : PWait;
  149.     HelpWin,
  150.     ArcViewWin     : windowptr;
  151.  
  152.     PROCEDURE RegisterFile(CONST FileName: PathStr; OldSize, Size: LongInt; CONST Method: S10);
  153.     VAR
  154.       a,TmpArc:ArcFilePtr;
  155.     BEGIN
  156.       IF MaxAvail<5120 THEN
  157.       BEGIN
  158.         Error:=True;
  159.       END ELSE
  160.       BEGIN
  161.         New(a);
  162.         IF Arc=NIL THEN
  163.         BEGIN
  164.           Arc:=a;
  165.         END ELSE
  166.         BEGIN
  167.           TmpArc:=Arc;
  168.           WHILE TmpArc^.Next<>NIL DO
  169.             TmpArc:=TmpArc^.Next;
  170.           Tmparc^.Next:=a;
  171.         END;
  172.         Inc(TotalArc.Files);
  173.         Inc(TotalArc.size,size);
  174.         Inc(TotalArc.OldSize,OldSize);
  175.         a^.FileName:=Copy(JustFileName(FileName),1,12);
  176.         replace(a^.FileName,'/','\',0);
  177.         a^.OldSize:=OldSize;
  178.         a^.NewSize:=Size;
  179.         a^.dt:=ArcDT;
  180.         a^.typ:=Method;
  181.         a^.Mark:=False;
  182.         a^.Next:=NIL;
  183.       END;
  184.     END;
  185.  
  186.     PROCEDURE ViewLZH(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait);
  187.     TYPE
  188.       LZHHeaderType =RECORD
  189.                          Headersize,{ No. bytes in header-2 (0=EOF) }
  190.                          chksum         : Byte;
  191.                          typ            : ARRAY[1..5] OF Char;
  192.                          size_now,
  193.                          orig_size      : LongInt;
  194.                          Time,
  195.                          Date,
  196.                          attrib         : Word;
  197.                          FileNameLength : Byte;
  198.                        END;
  199.     VAR
  200.       OldFilePos     : LongInt;
  201.       f              : FILE;
  202.       LZHHead        : LZHHeaderType;
  203.       test           : Word;
  204.  
  205.       PROCEDURE DoLZHHeader;
  206.       VAR
  207.         FileName       : PathStr;
  208.       BEGIN
  209.         BlockRead(f,FileName[1],LZHHead.FileNameLength,test);
  210.         FileName[0]:=Chr(LZHHead.FileNameLength);
  211.         Seek(f,OldFilePos+LZHHead.size_now+LZHHead.HeaderSize+2);
  212.         UnPackTime(LongInt(LZHHead.Time)+(LongInt(LZHHead.Date) SHL 16),ArcDT);
  213.         RegisterFile(FileName,LZHHead.orig_size,LZHHead.size_now,LZHHead.typ);
  214.       END;
  215.  
  216.     BEGIN
  217.       Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
  218.       Reset(f,1);
  219.       Seek(f,packetoffset);
  220.       WHILE NOT EOF(f) DO
  221.       BEGIN
  222.         OldFilePos:=FilePos(f);
  223.         BlockRead(f,LZHHead,SizeOf(LZHHead),test);
  224.         IF test=SizeOf(LZHHeaderType) THEN
  225.           IF (LZHHead.typ[1]='-') AND (LZHHead.typ[2]='l') AND
  226.           (LZHHead.typ[3]='h') AND (LZHHead.typ[5]='-') THEN DoLZHHeader ELSE Seek(f,FileSize(f));
  227.         IF Wait<>NIL THEN Wait^.Animate;
  228.       END;
  229.       Close(f);
  230.     END;
  231.  
  232.     PROCEDURE ViewZIP(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait);
  233.     TYPE
  234.       ZipMainHeader =RECORD
  235.                          PK_ID,
  236.                          HeadType       : Word; { local=$0403,CENTRAL=$0201,LAST=$0605 }
  237.                        END;
  238.  
  239.       ZipLocalHeader=RECORD
  240.                          extractversion,{ 1=IBM,2=AMIGA,4=VMS,8=UNIX }
  241.                          gp_flags,{ 1=ENCRYPTED }
  242.                          compression,
  243.                          mod_time,
  244.                          mod_date       : Word;
  245.                          Crc,
  246.                          size_now,
  247.                          real_size      : LongInt;
  248.                          name_length,
  249.                          ExtraField     : Word;
  250.                        END;
  251.       { Filename follows, no null terminator! }
  252.       { Extra field, no null terminator. }
  253.  
  254.       ZipCentralDirectory=RECORD
  255.                               VersionMadeBy,
  256.                               VersionNeeded,
  257.                               gp_flags,
  258.                               Method,
  259.                               LastTime,
  260.                               LastDate       : Word;
  261.                               Crc32,
  262.                               SizeNow,
  263.                               NormalSize     : LongInt;
  264.                               FileNameLength,
  265.                               ExtraField,
  266.                               FileCmntLength,
  267.                               DiskNumStart,
  268.                               IntFAttr       : Word;
  269.                               ExtFAttr,
  270.                               LocalOffset    : LongInt;
  271.                             END;
  272.  
  273.   {
  274.           filename (variable size)
  275.           extra field (variable size)
  276.           file comment (variable size)
  277.   }
  278.  
  279.       ZipCentralEnd =RECORD
  280.                          NumDisks,
  281.                          StartDisk,
  282.                          TotalEntryDisk,
  283.                          TotalEntryDir,
  284.                          DirSize        : Word;
  285.                          offset         : LongInt;
  286.                          CmntLength     : Word;
  287.                        END;
  288.  
  289.       { zipfile comment (variable size) }
  290.  
  291.     VAR
  292.       f              : FILE;
  293.       First          : ZipMainHeader;
  294.       test           : Word;
  295.  
  296.       FUNCTION ZIPType(n: Byte): S10;
  297.       BEGIN
  298.         CASE n OF
  299.           0 : ZIPType:='Stored';
  300.           1 : ZIPType:='Shrunk';
  301.        2..5 : ZIPType:='Reduced '+CHR(47+n);
  302.           6 : ZIPType:='Imploded';
  303.           7 : ZIPType:='Tokenized';
  304.           8 : ZIPType:='Inflated';
  305.          ELSE ZIPType:='Unknown';
  306.         END;
  307.       END;
  308.  
  309.       PROCEDURE DoLocalHeader;
  310.       VAR
  311.         Local          : ZipLocalHeader;
  312.         FNam           : PathStr;
  313.       BEGIN
  314.         BlockRead(f,Local,SizeOf(Local),test);
  315.         BlockRead(f,FNam[1],Local.name_length,test);
  316.         FNam[0]:=Chr(Local.name_length);
  317.         Seek(f,FilePos(f)+Local.size_now+Local.ExtraField);
  318.         UnPackTime(LongInt(Local.mod_time) + (LongInt(Local.mod_date) SHL 16),ArcDT);
  319.         RegisterFile(FNam,Local.real_size,Local.size_now,ZIPType(Local.compression));
  320.       END;
  321.  
  322.       PROCEDURE DoCentralEndHeader;
  323.       VAR
  324.         CentralEnd     : ZipCentralEnd;
  325.       BEGIN
  326.         BlockRead(f,CentralEnd,SizeOf(CentralEnd),test);
  327.         Seek(f,FilePos(f)+CentralEnd.CmntLength);
  328.       END;
  329.  
  330.       PROCEDURE DoCentralDirHeader;
  331.       VAR
  332.         CentralDir     : ZipCentralDirectory;
  333.       BEGIN
  334.         BlockRead(f,CentralDir,SizeOf(CentralDir),test);
  335. {        BlockRead(f,FNam[1],CentralDir.FileNameLength,test);
  336.         FNam[0]:=Chr(CentralDir.FileNameLength);}
  337.         Seek(f,FilePos(f)+CentralDir.FileNameLength+CentralDir.FileCmntLength+CentralDir.ExtraField);
  338.       END;
  339.  
  340.     BEGIN
  341.       Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
  342.       Reset(f,1);
  343.       Seek(f,packetoffset);
  344.       REPEAT
  345.         BlockRead(f,First,SizeOf(First),test);
  346.         CASE First.HeadType OF
  347.           $0403 : DoLocalHeader;
  348.           $0201 : DoCentralDirHeader;
  349.           $0605 : DoCentralEndHeader;
  350.         END;
  351.         IF Wait<>NIL THEN Wait^.Animate;
  352.       UNTIL (First.HeadType=$0605) OR EOF(f);
  353.       Close(f);
  354.     END;
  355.  
  356.     PROCEDURE ViewARC(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait); { OGSÅ brugt til PAK!!!!! }
  357.     TYPE
  358.       ARCHeaderType =RECORD
  359.                          Marker,
  360.                          version        : Byte;
  361.                          FileName       : ARRAY[1..13] OF Char;
  362.                          size_now       : LongInt;
  363.                          Date,   { packed date.  bits 0-4 =day  5-8=month  9-15=year-1980 }
  364.                          Time,   { packed time.  bits 0-4 =second / 2  5-10=minute  11-15=hour }
  365.                          Crc            : Word;
  366.                          orig_size      : LongInt;
  367.                        END;
  368.  
  369.     VAR
  370.       ARCHead        : ARCHeaderType;
  371.       f              : FILE;
  372.       test           : Word;
  373.  
  374.       FUNCTION ArcType(n: Byte): S10;
  375.       BEGIN
  376.         CASE n OF
  377.        1..2 : ArcType:='Stored';
  378.           3 : ArcType:='Packed';
  379.           4 : ArcType:='Squeezed';
  380.        5..8 : ArcType:='Crunched';
  381.           9 : ArcType:='Squashed';
  382.          10 : ArcType:='Crushed';
  383.          11 : ArcType:='Destilled';
  384.         ELSE  ArcType:='Unknown';
  385.         END;
  386.       END;
  387.  
  388.       PROCEDURE DoARCHeader;
  389.       VAR
  390.         FileName       : S13;
  391.       BEGIN
  392.         BlockRead(f,ARCHead,SizeOf(ARCHead),test);
  393.         IF ARCHead.version<>0 THEN
  394.         BEGIN
  395.           Move(ARCHead.FileName,FileName[1],13);
  396.           FileName[0]:=#13;
  397.           FileName[0]:=Chr(pos(#0,FileName)-1);
  398.           UnPackTime(LongInt(ARCHead.Time) + (LongInt(ARCHead.Date) SHL 16),ArcDT);
  399.           RegisterFile(FileName,ARCHead.orig_size,ARCHead.size_now,ArcType(ARCHead.version));
  400.           IF ARCHead.version<>1 THEN Seek(f,FilePos(f)+ARCHead.size_now) ELSE
  401.             Seek(f,FilePos(f)+ARCHead.size_now-4);
  402.         END;
  403.         IF Wait<>NIL THEN Wait^.Animate;
  404.       END;
  405.  
  406.     BEGIN
  407.       Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
  408.       Reset(f,1);
  409.       Seek(f,packetoffset);
  410.       ARCHead.version:=255;
  411.       WHILE (ARCHead.version<>0) DO
  412.         DoARCHeader;
  413.       Close(f);
  414.     END;
  415.  
  416.     PROCEDURE ViewARJ(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait);
  417.     Type
  418.       Arj1Header = Record
  419.         ID,           { $EA60 / "`Ω"}
  420.         HSize : Word; { Size of basic header }
  421.       End;
  422.       Arj2Header = Record
  423.         First_hdr_size, { Size of header }
  424.         ArjVersion,  { }
  425.         MinVersion,  { }
  426.         OS,          { MSDOS, PRIMOS, UNIX, AMIGA, MACDOS }
  427.         ArjFlags,    { }
  428.         ArjMethod,   { }
  429.         FileType,    { }
  430.         Reserved            : Byte; { }
  431.         Time,        { }
  432.         IsSize,      { }
  433.         WasSize,     { }
  434.         OriginalCRC         : LongInt;
  435.         AccessMode,
  436.         NamePos,
  437.         HostData            : Word;
  438.         { rest is variable size }
  439.       End;
  440.  
  441.     Var
  442.       Skipped  : BOOLEAN;
  443.       h1       : Arj1Header;
  444.       Buffer   : Array[0..4095] Of Byte;
  445.       h2       : Arj2Header Absolute Buffer;
  446.       BasicCrc : LongInt;
  447.       f        : File;
  448.       Hdr2Size,
  449.       i, k  : Word;
  450.       FileName : PathStr;
  451.  
  452.       FUNCTION ARJType(n: Byte): S10;
  453.       BEGIN
  454.         CASE n OF
  455.           0 : ARJType:='Stored';
  456.        1..4 : ARJType:='Mode '+CHR(48+n);
  457.        ELSE   ARJType:='Unknown';
  458.         END;
  459.       END;
  460.  
  461.     Begin
  462.       Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
  463.       Reset(f,1); Seek(f,PacketOffset);
  464.       Skipped:=False;
  465.       Repeat
  466.         BlockRead(f,h1,SizeOf(h1),k);
  467.         If h1.HSize<>0 Then
  468.         Begin
  469.           BlockRead(f, Buffer, h1.HSize, k);
  470.           UnPackTime(h2.Time, ArcDT);
  471.           i := h2.First_hdr_size;
  472.           FileName:='';
  473.           While (Buffer[i]<>0) And (i<=h1.HSize) Do
  474.           Begin
  475.             FileName:=FileName+Char(Buffer[i]);
  476.             Inc(i);
  477.           End;
  478.           If Buffer[i] <> 0 Then           { double nul <=> no comment }
  479.           Begin
  480.             While (Buffer[i] <> 0) And (i <= h1.HSize) Do
  481.               Inc(i);
  482.           End;
  483.           { skip secondary headers }
  484.           BlockRead(f, BasicCrc, 4, k); { Hdr CRC }
  485.           Repeat
  486.             BlockRead(f, Hdr2Size, 2, k);
  487.             Seek(f, FilePos(f) + Hdr2Size);
  488.             IF Hdr2Size<>0 THEN BlockRead(f, BasicCrc, 4, k); { Hdr CRC }
  489.           Until Hdr2Size = 0;
  490.  
  491.           IF Skipped THEN
  492.           BEGIN
  493.             Seek(f, FilePos(f)+h2.IsSize);
  494.             RegisterFile(FileName,h2.WasSize,h2.IsSize,ARJType(h2.ARJMethod))
  495.           END ELSE
  496.             Skipped:=True;
  497.         End;
  498.         IF Wait<>NIL THEN Wait^.Animate;
  499.       Until (h1.HSize = 0) Or EoF(f);
  500.       Close(f);
  501.     End;
  502.  
  503.     PROCEDURE ViewSQZ(CONST FNam: PathStr; PacketOffset: LongInt; Wait: PWait);
  504.     Type
  505.       SqzHeader = Record
  506.         ID           : ARRAY[1..5] OF CHAR; { Always 'HLSQZ' }
  507.         Version      : CHAR;
  508.         OS           : BYTE;
  509.         Flag         : BYTE;
  510.       End;
  511.       SqzFileHeader = Record
  512.         HdrSize,
  513.         HdrSum,
  514.         Method       : BYTE;
  515.         Compressed,
  516.         Original,
  517.         FileDate     : LONGINT;
  518.         Attrib       : BYTE;
  519.         FileCrc      : LONGINT;
  520.       End;
  521.       { File name is HdrSize-18 chars after this }
  522.  
  523.     Var
  524.       ah       : SqzHeader;
  525.       fh       : SqzFileHeader;
  526.       f        : File;
  527.       FileName : PathStr;
  528.       tl       : LONGINT;
  529.       NumRead  : INTEGER;
  530.       w        : WORD;
  531.  
  532.       FUNCTION SQZType(n: BYTE):S10;
  533.       BEGIN
  534.         CASE n OF
  535.           0    : SQZType:='Stored';
  536.           1..4 : SQZType:='Method '+Long2Str(n);
  537.           ELSE   SQZType:='Unknown';
  538.         END;
  539.       END;
  540.  
  541.     Begin
  542.       Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
  543.       Reset(f,1); Seek(f,PacketOffset);
  544.       BlockRead(f,ah,SizeOf(SqzHeader));
  545.       REPEAT
  546.         BlockRead(f,fh.HdrSize,1,NumRead);
  547.         IF NumRead<1 THEN Break;
  548.         CASE fh.HdrSize OF
  549.           0 : Break; {  End of archive }
  550.           1 : BEGIN      { Comment }
  551.                 BlockRead(f,w,2,NumRead);
  552.                 IF NumRead<2 THEN Break;
  553.                 BlockRead(f,w,2,NumRead);
  554.                 IF NumRead<2 THEN Break;
  555.                 Seek(f,FILEPOS(f)+w+5);
  556.                 IF IOResult<>0 THEN Break;
  557.               END;
  558.            2 : BEGIN      { Password }
  559.                 Seek(f,FILEPOS(f)+6);
  560.                 IF IOResult<>0 THEN Break;
  561.               END;
  562.           3 : BEGIN      { Security envelope }
  563.               END;
  564.       4..18 : BEGIN      { Skip everything but file headers }
  565.                 BlockRead(f,w,2,NumRead);
  566.                 IF NumRead<2 THEN Break;
  567.                 Seek(f,FILEPOS(f)+w);
  568.                 IF IOResult<>0 THEN Break;
  569.               END;
  570.           ELSE
  571.           BEGIN
  572.             BlockRead(f,fh.HdrSum,SizeOf(SqzFileHeader)-1,NumRead);
  573.             IF NumRead<SizeOf(SqzFileHeader)-1 THEN Break;
  574.             FileName[0]:=CHAR(fh.HdrSize-18);
  575.             BlockRead(f,FileName[1],fh.HdrSize-18,NumRead);
  576.             IF ah.Flag AND 2<>0 THEN tl:=fh.FileDate ELSE tl:=0;
  577.             UnpackTime(tl,ArcDT);
  578.             RegisterFile(FileName,fh.Original,fh.Compressed,SQZType(fh.Method));
  579.             Seek(f,FILEPOS(f)+fh.Compressed);
  580.             IF IOResult<>0 THEN Break;
  581.           END;
  582.         END;
  583.         IF Wait<>NIL THEN Wait^.Animate;
  584.       UNTIL EOF(f);
  585.       Close(f);
  586.     End;
  587.  
  588.     PROCEDURE DisplayGIFInfo(CONST FNam: PathStr);
  589.     VAR
  590.       s              : S10;
  591.       Colors,i,
  592.       BitsPerPixel   : Integer;
  593.       Temp           : windowptr;
  594.       f              : FILE;
  595.       buf            : RECORD
  596.                          signature,
  597.                          giftype        : ARRAY[1..3] OF Char;
  598.                          horizontal,
  599.                          Vertical       : Integer;
  600.                          colorsflag     : Byte;
  601.                        END;
  602.  
  603.     BEGIN
  604.       MyWin(Temp,25,6,55,14,3,'Info for GIF "'+JustFileName(FNam)+'"',True);
  605.       Assign(f,FNam); FileMode:=ShareRead+ShareDenyW;
  606.       Reset(f,1);
  607.       BlockRead(f,buf,SizeOf(buf),i);
  608.       Close(f);
  609.       BitsPerPixel:=buf.colorsflag AND 7+1;
  610.       IF BitsPerPixel=1 THEN Colors:=2 ELSE Colors:=1 SHL BitsPerPixel;
  611.       WITH Temp^ DO
  612.       BEGIN
  613.         wfasttext('GIF Type      : ',3,2);
  614.         wfasttext('Horizontal    : ',4,2);
  615.         wfasttext('Vertical      : ',5,2);
  616.         wfasttext('No. of colors : ',6,2);
  617.         s:='';
  618.         FOR i:=1 TO 3 DO
  619.           s:=s+buf.giftype[i];
  620.         wFastWrite(s,3,23,cfg.color[3].highlightcolor);
  621.         wFastWrite(LongIntForm('########',buf.horizontal),4,18,cfg.color[3].highlightcolor);
  622.         wFastWrite(LongIntForm('########',buf.Vertical),5,18,cfg.color[3].highlightcolor);
  623.         wFastWrite(LongIntForm('########',Colors),6,18,cfg.color[3].highlightcolor);
  624.       END;
  625.       REPEAT
  626.       UNTIL GotESC;
  627.       KillWindow(Temp);
  628.     END;
  629.  
  630.     PROCEDURE RunArcShell;
  631.     VAR
  632.       OldTopic,
  633.       OldTop, i,
  634.       MaxLine,
  635.       Line, Top,
  636.       InKey       : WORD;
  637.       TmpArc      : ArcFilePtr;
  638.       KeyWin      : WindowPtr;
  639.       ExtractPath : PathStr;
  640.  
  641.       PROCEDURE WriteArcLine(A:ArcFilePtr; y:BYTE; Current:BOOLEAN);
  642.       VAR
  643.         Attr:Byte;
  644.       BEGIN
  645.         WITH A^ DO
  646.         BEGIN
  647.           Attr:=CorrectAttribute(3,Current,A^.Mark);
  648.           HelpWin^.wfastWrite(CPad(CPad(FileName,13)+LongIntForm('#########',OldSize)+
  649.                               LongIntForm('#########',NewSize)+' '+CPad(Typ,12)+
  650.                               tochar(Dt.Day)+'/'+tochar(Dt.Month)+'-'+Long2Str(Dt.Year)+' '+
  651.                               tochar(Dt.Hour)+':'+tochar(Dt.Min)+':'+tochar(Dt.Sec),78),y,1,attr);
  652.         END;
  653.       END;
  654.  
  655.       PROCEDURE ShowFiles(Num:WORD);
  656.       VAR
  657.         i:WORD;
  658.       BEGIN
  659.         HelpWin^.Clear;
  660.         TmpArc:=Arc;
  661.         i:=0;
  662.         WHILE (TmpArc<>NIL) AND (i<Num) DO
  663.         BEGIN
  664.           INC(i);
  665.           TmpArc:=TmpArc^.Next;
  666.         END;
  667.         i:=0;
  668.         WHILE (i<HelpWin^.Height) AND (TmpArc<>NIL) DO
  669.         BEGIN
  670.           INC(i);
  671.           WriteArcLine(TmpArc,i,False);
  672.           TmpArc:=TmpArc^.Next;
  673.         END;
  674.         MaxLine:=i;
  675.         IF Line>MaxLine THEN Line:=MaxLine;
  676.       END;
  677.  
  678.       PROCEDURE DisposeFiles;
  679.       BEGIN
  680.         WHILE Arc<>NIL DO
  681.         BEGIN
  682.           TmpArc:=Arc;
  683.           Arc:=Arc^.Next;
  684.           Dispose(TmpArc);
  685.         END;
  686.       END;
  687.  
  688.       FUNCTION PtrNum(Num:WORD):ArcFilePtr;
  689.       VAR
  690.         p:ArcFilePtr;
  691.         i:WORD;
  692.       BEGIN
  693.         p:=Arc;
  694.         FOR i:=2 TO Num DO
  695.           IF P<>NIL THEN p:=p^.Next;
  696.         PtrNum:=p;
  697.       END;
  698.  
  699.       FUNCTION FindNum(Want:ArcFilePtr):WORD;
  700.       VAR
  701.         p:ArcFilePtr;
  702.         i:WORD;
  703.       BEGIN
  704.         IF Arc=NIL THEN i:=0 ELSE
  705.         BEGIN
  706.           p:=Arc;
  707.           i:=1;
  708.           WHILE (p<>NIL) AND (p<>Want) DO
  709.           BEGIN
  710.             p:=p^.Next;
  711.             INC(i);
  712.           END;
  713.           IF p<>Want THEN i:=0;
  714.         END;
  715.         FindNum:=i;
  716.       END;
  717.  
  718.       PROCEDURE GoDown;
  719.       BEGIN
  720.         IF Line<MaxLine THEN INC(Line) ELSE
  721.         BEGIN
  722.           IF Top+Line<TotalArc.Files THEN
  723.           BEGIN
  724.             INC(Top);
  725.             HelpWin^.ScrollVert(1);
  726.             WriteArcLine(PtrNum(Line+Top),HelpWin^.Height,False);
  727.           END;
  728.         END;
  729.       END;
  730.  
  731.       FUNCTION MarkCount:WORD;
  732.       VAR
  733.         i:WORD;
  734.       BEGIN
  735.         i:=0;
  736.         TmpArc:=Arc;
  737.         WHILE TmpArc<>NIL DO
  738.         BEGIN
  739.           IF TmpArc^.Mark THEN INC(i);
  740.           TmpArc:=TmpArc^.Next;
  741.         END;
  742.         MarkCount:=i;
  743.       END;
  744.  
  745.       PROCEDURE RemoveFromList(p:ArcFilePtr);
  746.       VAR
  747.         TmpArc,TmpArc2:ArcFilePtr;
  748.         i:WORD;
  749.       BEGIN
  750.         IF p=Arc THEN
  751.         BEGIN
  752.           TmpArc:=Arc;
  753.           Arc:=Arc^.Next;
  754.           Dispose(TmpArc);
  755.           DEC(TotalArc.Files);
  756.         END ELSE
  757.         BEGIN
  758.           i:=FindNum(p);
  759.           IF i>0 THEN
  760.           BEGIN
  761.             TmpArc:=PtrNum(i-1);
  762.             TmpArc2:=PtrNum(i+1);
  763.             TmpArc^.Next:=TmpArc2;
  764.             Dispose(p);
  765.             DEC(TotalArc.Files);
  766.           END;
  767.         END;
  768.       END;
  769.  
  770.       PROCEDURE UnMarkAll;
  771.       BEGIN
  772.         TmpArc:=Arc;
  773.         WHILE TmpArc<>NIL DO
  774.         BEGIN
  775.           TmpArc^.Mark:=False;
  776.           TmpArc:=TmpArc^.Next;
  777.         END;
  778.         ShowFiles(Top);
  779.       END;
  780.  
  781.       PROCEDURE DeleteFiles;
  782.       VAR
  783.         b,MarkedOne:BOOLEAN;
  784.         s:STRING;
  785.       BEGIN
  786.         IF MarkCount=0 THEN
  787.         BEGIN
  788.           MarkedOne:=True;
  789.           TmpArc:=PtrNum(Top+Line);
  790.           TmpArc^.Mark:=True;
  791.         END ELSE
  792.           MarkedOne:=False;
  793.  
  794.         IF MarkedOne THEN b:=Confirm('Delete current file','N',8)
  795.                      ELSE b:=Confirm('Delete marked file(s)','N',8);
  796.         IF b THEN
  797.         BEGIN
  798.           TmpArc:=Arc;
  799.           WHILE TmpArc<>NIL DO
  800.           BEGIN
  801.             s:='';
  802.             WHILE (TmpArc<>NIL) AND (LENGTH(s)<60) DO
  803.             BEGIN
  804.               IF TmpArc^.Mark THEN
  805.               BEGIN
  806.                 IF s<>'' THEN s:=s+' ';
  807.                 s:=s+TmpArc^.FileName;
  808.                 RemoveFromList(TmpArc);
  809.                 TmpArc:=Arc;
  810.               END
  811.               ELSE TmpArc:=TmpArc^.Next;
  812.             END;
  813.             IF s<>'' THEN
  814.             BEGIN
  815.               ArcCommand(ArcType,3,FNam,s);
  816.             END;
  817.           END;
  818.         END;
  819.         IF MarkedOne THEN UnMarkAll;
  820.         ShowFiles(Top);
  821.       END;
  822.  
  823.       PROCEDURE TestArchive;
  824.       BEGIN
  825.         IF Confirm('Test archive','Y',8) THEN
  826.         BEGIN
  827.           IF ArcCommand(ArcType,4,FNam,'') THEN
  828.             UserInformation(8,'Archive seems to be intact',4,2000)
  829.           ELSE
  830.             UserInformation(8,'Archive seems to be damaged',4,2001);
  831.         END;
  832.       END;
  833.  
  834.       PROCEDURE ExtractFiles;
  835.       VAR
  836.         s        : STRING;
  837.         OldDir   : PathStr;
  838.         MarkedOne: BOOLEAN;
  839.       BEGIN
  840.         GetDir(0,OldDir);
  841.         IF SelectPath(ExtractPath) THEN
  842.         BEGIN
  843.           IF MarkCount=0 THEN
  844.           BEGIN
  845.             MarkedOne:=True;
  846.             TmpArc:=PtrNum(Top+Line);
  847.             TmpArc^.Mark:=True;
  848.           END
  849.           ELSE MarkedOne:=False;
  850.  
  851.           ChangeDir(ExtractPath);
  852.           TmpArc:=Arc;
  853.           WHILE TmpArc<>NIL DO
  854.           BEGIN
  855.             s:='';
  856.             WHILE (TmpArc<>NIL) AND (LENGTH(s)<60) DO
  857.             BEGIN
  858.               IF TmpArc^.Mark THEN
  859.               BEGIN
  860.                 IF s<>'' THEN s:=s+' ';
  861.                 s:=s+TmpArc^.FileName;
  862.               END;
  863.               TmpArc:=TmpArc^.Next;
  864.             END;
  865.             IF s<>'' THEN ArcCommand(ArcType,2,FNam,s);
  866.           END;
  867.           ChangeDir(OldDir);
  868.           IF MarkedOne THEN UnMarkAll;
  869.         END;
  870.       END;
  871.  
  872.     BEGIN
  873.       MyWin(KeyWin,1,ScreenHeight-1,80,ScreenHeight,3,'',False);
  874.       WITH KeyWin^ DO
  875.       BEGIN
  876.         wFastText('F1=Help        F2=Delete      F3=Test         F4=Extract',1,1);
  877.       END;
  878.       OldTopic:=Topic;
  879.       Topic:=62;
  880.       ExtractPath:=StartPath;
  881.       Line:=1;
  882.       Top:=0;
  883.       HelpWin^.Select;
  884.       ShowFiles(Top);
  885.       REPEAT
  886.         WriteArcLine(PtrNum(Line+Top),Line,True);
  887.         InKey:=PoPReadKeyWord;
  888.         WriteArcLine(PtrNum(Line+Top),Line,False);
  889.         CASE InKey OF
  890.           Home : BEGIN
  891.                    OldTop:=Top;
  892.                    Top:=0;
  893.                    Line:=1;
  894.                    IF OldTop<>Top THEN ShowFiles(Top);
  895.                  END;
  896.           Up   : IF Line>1 THEN DEC(Line) ELSE
  897.                  BEGIN
  898.                    IF Top>0 THEN
  899.                    BEGIN
  900.                      DEC(Top);
  901.                      HelpWin^.ScrollVert(-1);
  902.                      WriteArcLine(PtrNum(Line+Top),1,False);
  903.                    END;
  904.                  END;
  905.           PgUp : BEGIN
  906.                    OldTop:=Top;
  907.                    i:=HelpWin^.Height-1;
  908.                    REPEAT
  909.                      DEC(i);
  910.                      IF Line>1 THEN DEC(Line) ELSE
  911.                        IF Top>0 THEN DEC(Top);
  912.                    UNTIL i=0;
  913.                    IF OldTop<>Top THEN ShowFiles(Top);
  914.                  END;
  915.           Down : GoDown;
  916.           PgDn : BEGIN
  917.                    OldTop:=Top;
  918.                    i:=HelpWin^.Height-1;
  919.                    REPEAT
  920.                      DEC(i);
  921.                      IF (Line<HelpWin^.Height) THEN
  922.                      BEGIN
  923.                        IF Line<TotalArc.Files-Top THEN INC(Line);
  924.                      END
  925.                      ELSE
  926.                        IF Top<TotalArc.Files-HelpWin^.Height THEN INC(Top);
  927.                    UNTIL i=0;
  928.                    IF OldTop<>Top THEN ShowFiles(Top);
  929.                  END;
  930.         EndKey : BEGIN
  931.                    IF TotalArc.Files>HelpWin^.Height THEN
  932.                    BEGIN
  933.                      OldTop:=Top;
  934.                      Top:=TotalArc.Files-HelpWin^.Height;
  935.                      IF OldTop<>Top THEN ShowFiles(Top);
  936.                      Line:=MaxLine;
  937.                    END ELSE
  938.                    BEGIN
  939.                      Top:=0;
  940.                      Line:=MaxLine;
  941.                    END;
  942.                  END;
  943.          Enter : BEGIN
  944.                    TmpArc:=PtrNum(Top+Line);
  945.                    TmpArc^.Mark:=NOT TmpArc^.Mark;
  946.                    WriteArcLine(TmpArc,Line,False);
  947.                    GoDown;
  948.                  END;
  949.          Space : UnMarkAll;
  950.             F2 : DeleteFiles;
  951.             F3 : TestArchive;
  952.             F4 : ExtractFiles;
  953.         END;
  954.       UNTIL InKey=Esc;
  955.       DisposeFiles;
  956.       KillWindow(KeyWin);
  957.       Topic:=OldTopic;
  958.     END;
  959.  
  960.   BEGIN
  961. {$IFNDEF PoPLite}
  962.     Arc:=NIL;
  963.     IF (ArcType<>0) AND (ArcType<>127) THEN
  964.     BEGIN
  965.       MyWin(ArcViewWin,1,2,80,ScreenHeight-3,3,'Viewing archive: '+JustFileName(FNam),False);
  966.       ArcViewWin^.wfastwrite('File Name    File Size Size Now Method      File Date & Time     ' +
  967.                       charstr(' ',13),1,1,cfg.color[3].blockcolor);
  968.       MyWin(HelpWin,2,4,79,ScreenHeight-4,3,'',False);
  969.       FillChar(TotalArc,SizeOf(TotalArc),#0);
  970.     END;
  971.     Error:=False;
  972.     IF ArcType<>127 THEN New(Wait, Init(8, 2,'Reading archive contents'));
  973.     CASE ArcType OF
  974.       -2,2      : ViewZIP(FNam, SelfExtractingOffset, Wait);
  975.       -3,3      : ViewLZH(FNam, SelfExtractingOffset, Wait);
  976.       -1,-4,1,4 : ViewARC(FNam, SelfExtractingOffset, Wait);
  977.       -6,6      : ViewSQZ(FNam, SelfExtractingOffset, Wait);
  978.       7,-7      : ViewARJ(FNam, SelfExtractingOffset, Wait);
  979.       127       : DisplayGIFInfo(FNam);
  980.     END;
  981.  
  982.     IF ArcType<>127 THEN Dispose(Wait, Done);
  983.     IF Error THEN
  984.     BEGIN
  985.       AskError(8,'Not enough memory to display archive',4);
  986.     END ELSE
  987.     BEGIN
  988.       IF (ArcType<>0) AND (ArcType<>127) THEN
  989.       BEGIN
  990.         RunArcShell;
  991.         KillWindow(ArcViewWin);
  992.         KillWindow(HelpWin);
  993.       END;
  994.     END;
  995. {$ELSE}
  996.   AskError(10, 'Not implemented in Portal of Power/Lite', 2);
  997. {$ENDIF}
  998.   END;
  999.  
  1000. END.
  1001.